Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue46/Alfresco/AAVarLst.pas

Pascal/Delphi Source File | 1999-04-24 | 6.2 KB | 223 lines

{*********************************************************}
{* AAVarLst                                              *}
{* Copyright (c) Julian M Bucknall 1998-1999             *}
{* All rights reserved.                                  *}
{*********************************************************}
{* List of variables/values                              *}
{*********************************************************}

{Note: this unit is released as freeware. In other words, you are free
       to use this unit in your own applications, however I retain all
       copyright to the code. JMB}

unit AAVarLst;

interface

uses
  AAStStk,
  SysUtils;

type
  PaaVariableNode = ^TaaVariableNode;
  TaaVariableNode = packed record
    vnString : PaaString255;
    vnValue  : double;
  end;

const
  aaMaxVarItems = MaxInt div sizeof(TaaVariableNode);

type
  PaaVariableArray = ^TaaVariableArray;
  TaaVariableArray = array [0..pred(aaMaxVarItems)] of TaaVariableNode;

type
  TaaVariableList = class
    private
      FArray    : PaaVariableArray;
      FCapacity : integer;
      FCount    : integer;
      FStStack  : TaaStringStack;
    protected
      function vlGetName(aInx : integer) : TaaString255;
      function vlGetValue(const aName : TaaString255) : double;
      procedure vlSetValue(const aName  : TaaString255;
                           const aValue : double);
      procedure vlSetCapacity(aValue : integer);

      function vlFindName(const aName  : TaaString255;
                            var aIndex : integer) : boolean;
      procedure vlGrowArray;
    public
      constructor Create;
        {-create the variable list}
      destructor Destroy; override;
        {-destroy the variable list; releasing all memory}

      procedure Clear;
        {-remove all variables from list}
      function GetValue(const aName  : TaaString255;
                          var aValue : double) : boolean;
        {-return true and the value of a variable if the variable
          exists; false otherwise}
      function IsEmpty : boolean;
        {-is the list empty?}

      property Capacity : integer
         read FCapacity write vlSetCapacity;
        {-capacity of the list}
      property Count : integer
         read FCount;
        {-count of variables in the list}
      property Name[aInx : integer] : TaaString255
         read vlGetName;
        {-array of variable names}
      property Value[const aName : TaaString255] : double
         read vlGetValue write vlSetValue;
        {-associative array of variable names and their values; on
          read, if the variable does not exist, 0.0 is returned}
    end;

implementation


{===TaaVariableList===================================================}
constructor TaaVariableList.Create;
begin
  inherited Create;
  FStStack := TaaStringStack.Create(1024);
end;
{--------}
destructor TaaVariableList.Destroy;
begin
  FStStack.Free;
  Capacity := 0;
  inherited Destroy;
end;
{--------}
procedure TaaVariableList.Clear;
begin
  FCount := 0;
  FStStack.Clear;
end;
{--------}
function TaaVariableList.GetValue(const aName  : TaaString255;
                                    var aValue : double) : boolean;
var
  Inx : longint;
begin
  Result := vlFindName(aName, Inx);
  if Result then
    aValue := FArray^[Inx].vnValue;
end;
{--------}
function TaaVariableList.IsEmpty : boolean;
begin
  Result := (FCount = 0);
end;
{--------}
function TaaVariableList.vlFindName(const aName  : TaaString255;
                                      var aIndex : integer) : boolean;
var
  L, R, M : longint;
  MidNode : PaaVariableNode;
begin
  {binary search}
  L := 0;
  R := pred(Count);
  while (L <= R) do begin
    M := (L + R) div 2;
    MidNode := @FArray^[M];
    if (MidNode^.vnString^ < aName) then
      L := succ(M)
    else if (MidNode^.vnString^ > aName) then
      R := pred(M)
    else {found it} begin
      aIndex := M;
      Result := true;
      Exit;
    end;
  end;
  aIndex := L;
  Result := false;
end;
{--------}
function TaaVariableList.vlGetName(aInx : integer) : TaaString255;
begin
  if (0 <= aInx) and (aInx < Count) then
    Result := FArray^[aInx].vnString^;
end;
{--------}
function TaaVariableList.vlGetValue(const aName : TaaString255) : double;
begin
  if not GetValue(aName, Result) then
    Result := 0.0;
end;
{--------}
procedure TaaVariableList.vlGrowArray;
begin
  if (Capacity = 0) then
    Capacity := 4
  else if (Capacity < 64) then
    Capacity := Capacity * 2
  else
    Capacity := Capacity + (Capacity div 4);
end;
{--------}
procedure TaaVariableList.vlSetValue(const aName  : TaaString255;
                                     const aValue : double);
var
  Inx : integer;
begin
  {make sure there's enough room}
  if (Count = Capacity) then
    vlGrowArray;
  {first the simple case}
  if (Count = 0) then begin
    FArray^[0].vnString := FStStack.Push(aName);
    FArray^[0].vnValue := aValue;
    inc(FCount);
  end
  {next the case where the name is already present}
  else if vlFindName(aName, Inx) then begin
    FArray^[Inx].vnValue := aValue;
  end
  {finally the case where the name is not present}
  else begin
    if (Inx <> Count) then
      Move(FArray^[Inx], FArray^[Inx+1],
           (Count - Inx) * sizeof(TaaVariableNode));
    FArray^[Inx].vnString := FStStack.Push(aName);
    FArray^[Inx].vnValue := aValue;
    inc(FCount);
  end;
end;
{--------}
procedure TaaVariableList.vlSetCapacity(aValue : integer);
var
  NewArray  : PaaVariableArray;
  CopyCount : longint;
begin
  if (aValue <> FCapacity) then begin
    if (aValue < FCapacity) then begin
      CopyCount := aValue;
      if (aValue < FCount) then
        FCount := aValue;
    end
    else
      CopyCount := FCapacity;
    if (aValue > 0) then
      GetMem(NewArray, longint(aValue) * sizeof(TaaVariableNode));
    if (CopyCount > 0) then
      Move(FArray^, NewArray^, CopyCount * sizeof(TaaVariableNode));
    if (FCapacity > 0) then
      FreeMem(FArray, longint(FCapacity) * sizeof(TaaVariableNode));
    FArray := NewArray;
    FCapacity := aValue;
  end;
end;
{====================================================================}

end.